home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / oletools / oletools.bas < prev   
Encoding:
BASIC Source File  |  1993-12-26  |  5.0 KB  |  181 lines
  1. Option Explicit
  2. Const OLE_SAVE_TO_FILE = 11
  3. Const OLE_READ_FROM_FILE = 12
  4. Const BuffSize = 1024 * 16
  5.  
  6. Function CopyOLEData (SourceOLE As OLE, TargetOLE As OLE) As Integer
  7.     Dim FileNum As Integer
  8.     Dim OLESize As Long
  9.     Dim FileName As String
  10.  
  11.     CopyOLEData = True
  12.     
  13.     FileName = TempOLEFileName()
  14.     On Error GoTo CopyOLEData_CantWriteTemp
  15.     FileNum = FreeFile
  16.     Open FileName For Binary As #FileNum
  17.     SourceOLE.FileNumber = FileNum
  18.     SourceOLE.Action = OLE_SAVE_TO_FILE
  19.     Close #FileNum
  20.     OLESize = FileLen(FileName)
  21.     
  22.     On Error GoTo CopyOLEData_CantReadFromTemp
  23.     FileNum = FreeFile
  24.     Open FileName For Binary As #FileNum
  25.     TargetOLE.FileNumber = FileNum
  26.     TargetOLE.Action = OLE_READ_FROM_FILE
  27.     Close #FileNum
  28.     On Error GoTo CopyOLEData_CouldntKillTemp:
  29.     Kill FileName
  30.     
  31.     Exit Function
  32.  
  33. ' ##### ERROR HANDLER #####
  34. CopyOLEData_CantWriteTemp:
  35.     Debug.Print "ERROR: CopyOLEData_CantWriteTemp - " & Error$
  36.     CopyOLEData = False
  37.     Exit Function
  38.  
  39. CopyOLEData_CantReadFromTemp:
  40.     Debug.Print "ERROR: CopyOLEData_CantReadFromTemp - " & Error$
  41.     CopyOLEData = False
  42.     Exit Function
  43.  
  44. CopyOLEData_CouldntKillTemp:
  45.     Debug.Print "ERROR: CopyOLEData_TempNotFound - " & Error$
  46.     CopyOLEData = False
  47.     Exit Function
  48.  
  49. End Function
  50.  
  51. Function DBField2OLEObj (TheField As Field, OLE1 As OLE) As Integer
  52.     Dim FileNum As Integer
  53.     Dim OLESize As Long
  54.     Dim Buffer As String
  55.     Dim Offset As Long
  56.     Dim FileName As String
  57.     Dim RestLen As Long
  58.  
  59.     DBField2OLEObj = True
  60.  
  61.     FileName = TempOLEFileName()
  62.     
  63.     OLESize = TheField.FieldSize()
  64.  
  65.     FileNum = FreeFile
  66.     On Error GoTo DbField2OLEObj_CouldntWriteTemp
  67.     Open FileName For Binary As #FileNum
  68.     RestLen = OLESize
  69.     Offset = 0
  70.     While RestLen > BuffSize
  71.         Buffer = ""
  72.         Buffer = TheField.GetChunk(Offset, BuffSize)
  73.         If Len(Buffer) <> BuffSize GoTo DbField2OLEObj_InvalidGetChunkLen
  74.         On Error GoTo DbField2OLEObj_CouldntWriteTemp
  75.         Put FileNum, , Buffer
  76.         RestLen = RestLen - BuffSize
  77.         Offset = Offset + BuffSize
  78.     Wend
  79.     Buffer = ""
  80.     Buffer = TheField.GetChunk(Offset, RestLen)
  81.     If Len(Buffer) <> RestLen GoTo DbField2OLEObj_InvalidGetChunkLen
  82.     On Error GoTo DbField2OLEObj_CouldntWriteTemp
  83.     Put FileNum, , Buffer
  84.     Close FileNum
  85.  
  86.     FileNum = FreeFile
  87.     Open FileName For Binary As #FileNum
  88.     OLE1.FileNumber = FileNum
  89.     OLE1.Action = OLE_READ_FROM_FILE
  90.     Close #FileNum
  91.     On Error GoTo DbField2OLEObj_CouldntKillTemp:
  92.     Kill FileName
  93.  
  94.     Exit Function
  95.  
  96. ' ##### ERROR HANDLERS #####
  97. DbField2OLEObj_InvalidGetChunkLen:
  98.     Debug.Print "ERROR: DbField2OLEObj_InvalidGetChunkLen - " & "GetChunk returned invalid len!"
  99.     DBField2OLEObj = False
  100.     Exit Function
  101.  
  102. DbField2OLEObj_CouldntWriteTemp:
  103.     Debug.Print "ERROR: DbField2OLEObj_CouldntWriteTemp - " & Error$
  104.     DBField2OLEObj = False
  105.     Exit Function
  106.  
  107. DbField2OLEObj_CouldntKillTemp:
  108.     Debug.Print "ERROR: DbField2OLEObj_TempNotFound - " & Error$
  109.     DBField2OLEObj = False
  110.     Exit Function
  111.  
  112. End Function
  113.  
  114. Function OLEObj2DbField (OLE1 As OLE, TheField As Field) As Integer
  115.     Dim FileNum As Integer
  116.     Dim OLESize As Long
  117.     Dim FileName As String
  118.     Dim RestLen As Long
  119.     Dim Buffer As String
  120.     Dim DbgOLESize As Long
  121.     
  122.  
  123.     OLEObj2DbField = True
  124.     
  125.     FileName = TempOLEFileName()
  126.     On Error GoTo OLEObj2DbField_CantCreateTemp
  127.     FileNum = FreeFile
  128.     Open FileName For Binary As #FileNum
  129.     OLE1.FileNumber = FileNum
  130.     On Error GoTo OLEObj2DbField_DiskSpace
  131.     OLE1.Action = OLE_SAVE_TO_FILE
  132.     Close #FileNum
  133.     OLESize = FileLen(FileName)
  134.     
  135.     FileNum = FreeFile
  136.     On Error GoTo OLEObj2DbField_CantCreateTemp
  137.     Open FileName For Binary As #FileNum
  138.     RestLen = OLESize
  139.     While RestLen > BuffSize
  140.         Buffer = String$(BuffSize, 32)
  141.         Get FileNum, , Buffer
  142.         TheField.AppendChunk (Buffer)
  143.         RestLen = RestLen - BuffSize
  144.     Wend
  145.     Buffer = String$(RestLen, 32)
  146.     Get FileNum, , Buffer
  147.     TheField.AppendChunk (Buffer)
  148.     DbgOLESize = TheField.FieldSize()
  149.     Close FileNum
  150.     On Error GoTo OLEObj2DbField_CouldntKillTemp
  151.     Kill FileName
  152.     Exit Function
  153.  
  154. ' ##### ERROR HANDLER #####
  155. OLEObj2DbField_CantCreateTemp:
  156.     Debug.Print "ERROR: OLEObj2DbField_CantCreateTemp - " & Error$
  157.     OLEObj2DbField = False
  158.     Exit Function
  159.  
  160. OLEObj2DbField_DiskSpace:
  161.     Debug.Print "ERROR: OLEObj2DbField_DiskSpace - " & Error$
  162.     OLEObj2DbField = False
  163.     Exit Function
  164.  
  165. OLEObj2DbField_CantOpenTemp:
  166.     Debug.Print "ERROR: OLEObj2DbField_TempNotFound - " & Error$
  167.     OLEObj2DbField = False
  168.     Exit Function
  169.  
  170. OLEObj2DbField_CouldntKillTemp:
  171.     Debug.Print "ERROR: OLEObj2DbField_TempNotFound - " & Error$
  172.     OLEObj2DbField = False
  173.     Exit Function
  174.  
  175. End Function
  176.  
  177. Function TempOLEFileName () As String
  178.     TempOLEFileName = App.Path + "\$OLETMP$.TMP"
  179. End Function
  180.  
  181.